Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-20/nrd33.zip/NRDIO.PAS

Pascal/Delphi Source File | 1991-05-14 | 22KB | 822 lines

{$I-}
{$V-}

unit nrdio;

interface

const DATELEN     = 6;
      TIMELEN     = 4;
      LONGSTRLEN  = 255;
      MEDSTRLEN   = 80;
      SHORTSTRLEN = 8;
      CALLSIGNLEN = 19;
      LOCATIONLEN = 27;
      COMMENTLEN  = 69;
      MAXREC      = 2500; { maximum records in a log }
      MAXLOGS     = 15;

      PATH        = '';
      LOGFILE     = 'LOG';
      RECFILE     = 'REC';
      RECDATAFILE = 'RECDAT';
      LOGLISTFILE = 'LOGLIST.DAT';

      FILE_NOT_FOUND = 2;

type  longstr       = string[LONGSTRLEN];
      datetype      = string[DATELEN];
      timetype      = string[TIMELEN];
      calltype      = string[CALLSIGNLEN];
      locationtype  = string[LOCATIONLEN];
      commenttype   = string[COMMENTLEN];

      modetype      = (RTTY, CW, USB, LSB, AM, FM, FAX, ECSS_USB, ECSS_LSB);
      bandwidthtype = (NARR, INTER, WIDE, AUX);
      agctype       = (OFF, FAST, SLOW);
      attentype     = (NO, YES);
      rectype       = (SHOW, HIDE, DELETED);

      logtype = record
                  date:       datetype;
                  begin_time,
                  end_time:   timetype;
                  frequency:  real;
                  callsign:   calltype;
                  location:   locationtype;
                  comment:    commenttype;
                  mode:       modetype;
                  bandwidth:  bandwidthtype;
                  agc:        agctype;
                  attenuator: attentype;
                end;

      recarraytype = packed array[1..MAXREC] of 0..MAXREC;

      recdatatype = packed record
                  recptr:   recarraytype;
                  m7000ptr: recarraytype; { not used }
                  recstat:  packed array[1..MAXREC] of rectype;
                end;

      short_str = string[SHORTSTRLEN];

      sort_array_type = array[1..MAXREC] of short_str;

      journaltype = record
                  logname:  short_str;
                  records,
                  rec:      integer;
                end;

      loglisttype = record
                  logcount,
                  currentlog: byte;
                  log:         array[1..MAXLOGS] of journaltype;
                end;

      configtype = record
                  com_port:byte;
                  receiver_type:word;
                  has_map:boolean;
                  time_offset:byte;
                end;

      receivertype = record
                  channel:    byte;
                  frequency:  real;
                  mode:       modetype;
                  bandwidth:  bandwidthtype;
                  agc:        agctype;
                  attenuator: attentype;
                end;

  var recbuf, recdatabuf, loglistbuf:file;
      recdata:recdatatype;
      records:integer;     { total number of records }
      loglist:loglisttype;
      rec:integer;
      receiverstat:receivertype;
      has_map:boolean;
      com_nrd:byte;
      radio_type:word;
      gmt_offset:byte;

  procedure get_records(var records:integer);
  procedure put_records(records:word);
  procedure get_recdata(thelog:byte; var recdata:recdatatype);
  procedure put_recdata(thelog:byte; recdata:recdatatype);
  procedure open_log(var logbuf: file; thelog:byte; var rslt:integer);
  procedure get_log(var logbuf:file; var logdata:logtype; rec:integer);
  procedure put_log(var logbuf:file; logdata:logtype; rec:integer);
  procedure get_loglist(var loglist:loglisttype);
  procedure put_loglist(loglist:loglisttype);
  procedure init_com; { open com and set up for session }
  procedure write_com(port:byte; s:string);
  procedure comreadln(port:byte; var s:string);
  procedure remote_on;{ enable remote control of radio, get receiver status }
  procedure remote_off(dly:word);
  procedure toggle_remote;
  procedure check_status(var s:string);
  procedure set_freq(frequency:real);
  procedure set_mode(mode:modetype);
  procedure set_bandwidth(bandwidth:bandwidthtype);
  procedure set_agc(agc:agctype);
  procedure set_attenuator(attenuator:attentype);
  procedure set_all(channel:byte; attenuator:attentype;
                     bandwidth:bandwidthtype; mode:modetype; frequency:real;
                     agc:agctype);

  implementation

  uses async, crt, dos, screen;

  procedure open_records(var rslt:integer);
  var ch:char;
  begin
    assign(recbuf,PATH+RECFILE+'.DAT');
    repeat
      reset(recbuf,sizeof(records));
      rslt:=ioresult;
      if rslt = FILE_NOT_FOUND then
        begin
          rewrite(recbuf,sizeof(records));
          records:=0;
          blockwrite(recbuf,records,1);
          close(recbuf);
          reset(recbuf,sizeof(records));
          rslt:=ioresult;
        end;
      hndlerr(FALSE,ch,rslt);
    until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  end;

  procedure get_records;
  var ch:char;
      rslt:integer;
  begin
    open_records(rslt);
    if rslt = 0 then
      begin
        blockread(recbuf,records,1);
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(recbuf);
  end;

  procedure put_records;
  var ch:char;
      rslt:integer;
  begin
    open_records(rslt);
    if rslt = 0 then
      begin
        blockwrite(recbuf,records,1);
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(recbuf);
  end;

  procedure open_recdata(thelog:byte; var rslt:integer);
  var ch:char;
      s:string;
      i:integer;
  begin
    str(thelog,s);
    if length(s) = 1 then s:='0' + s;
    assign(recdatabuf,PATH+RECDATAFILE + s + '.DAT');
    repeat
      reset(recdatabuf,sizeof(recdata));
      rslt:=ioresult;
      if rslt = FILE_NOT_FOUND then
        begin
          for i:=1 to MAXREC do with recdata do
            begin
              if i <= records then
                begin
                   recptr[i]:= i;
                   recstat[i]:= SHOW
                end
              else
                begin
                  recptr[i]:=0;
                  recstat[i]:=DELETED;
                end;
              m7000ptr[i]:=0;
            end;
          rewrite(recdatabuf,sizeof(recdata));
          blockwrite(recdatabuf,recdata,1);
          close(recdatabuf);
          reset(recdatabuf,sizeof(recdata));
          rslt:=ioresult;
        end;
      hndlerr(FALSE,ch,rslt);
    until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  end;

  procedure get_recdata;

  var ch:char;
      rslt:integer;
  begin
    open_recdata(thelog,rslt);
    if rslt = 0 then
      begin
        blockread(recdatabuf,recdata,1);
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(recdatabuf);
  end;

  procedure put_recdata;

  var ch:char;
      rslt:integer;
  begin
    open_recdata(thelog,rslt);
    if rslt = 0 then
      begin
        blockwrite(recdatabuf,recdata,1);
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(recdatabuf);
  end;

  procedure open_log;

  var ch:char;
      s:string;
  begin
    str(thelog,s);
    if length(s) = 1 then s:='0'+s;
    assign(logbuf,PATH+LOGFILE+s+'.DAT');
    reset(logbuf,sizeof(logtype));
    repeat
      rslt:=IORESULT;
      if rslt = FILE_NOT_FOUND then
        begin
          rewrite(logbuf,sizeof(logtype));
          rslt:=ioresult;
        end;
      hndlerr(FALSE,ch,rslt);
    until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  end;

  procedure get_log;

  var rslt:integer;
      ch:char;
  begin
    seek(logbuf,rec - 1);
    blockread(logbuf,logdata,1);
    rslt:=ioresult;
    if rslt > 0 then
      begin
        hndlerr(TRUE,ch,rslt);
      end;
  end;

  procedure put_log;

  var ch:char;
      rslt:integer;

  begin
    seek(logbuf,rec - 1);
    blockwrite(logbuf,logdata,1);
    rslt:=ioresult;
    if rslt > 0 then
      begin
        hndlerr(TRUE,ch,rslt);
      end;
  end;



  procedure open_loglist(var rslt:integer);
  var ch:char;
  begin
    assign(loglistbuf,PATH+LOGLISTFILE);
    repeat
      reset(loglistbuf,sizeof(loglisttype));
      rslt:=ioresult;
      if rslt = FILE_NOT_FOUND then
        begin
          rewrite(loglistbuf,sizeof(loglisttype));
          loglist.logcount:=0;
          blockwrite(loglistbuf,loglist,1);
          close(loglistbuf);
          reset(loglistbuf,sizeof(loglisttype));
          rslt:=ioresult;
        end;
      hndlerr(FALSE,ch,rslt);
    until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  end;

  procedure get_loglist;

  var ch:char;
      rslt:integer;
  begin
    open_loglist(rslt);
    if rslt = 0 then
      begin
        blockread(loglistbuf,loglist,1);
        if loglist.logcount = 0 then
          begin
            records:=0;
            rec:=1;
          end
        else
          begin
            records:=loglist.log[loglist.currentlog].records;
            rec:=    loglist.log[loglist.currentlog].rec;
          end;
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(loglistbuf);
  end;

  procedure put_loglist;

  var ch:char;
      rslt:integer;
  begin
    open_loglist(rslt);
    if rslt = 0 then
      begin
        blockwrite(loglistbuf,loglist,1);
        rslt:=ioresult;
        hndlerr(FALSE,ch,rslt);
      end;
    close(loglistbuf);
  end;

  procedure init_com; { open com and set up for session }
  var baud:integer;
  begin
    if radio_type = 525 then baud:=1200 else
    if radio_type = 535 then baud:=4800;
    async_init;
    if COM_NRD = 0 then exit;
    if not async_open(COM_NRD,baud,'N',8,1) then
      begin
        writeln('Com port failure');
        halt;
      end;
  end;

  procedure write_com;
  begin
    if COM_NRD = 0 then exit;
    if radio_type = 535 then s:=s + chr(13);
    async_send_string(s);
  end;

  procedure comreadln;
  var ch:char;
      gotchar, done:boolean;
      error_count:integer;
  begin
    s:='';
    if COM_NRD = 0 then
      begin
        s:='000000';
        exit;
      end;
    done:=FALSE;
    error_count:=0;
    while not done do
      begin
        gotchar:=async_buffer_check(ch);
        if  not gotchar then
          begin
            delay(20);
            inc(error_count);
          end
        else error_count:=0;
        if error_count > 40 then exit;
        done:=ch = #013;
        if not done and gotchar then s:=s + ch;
      end;
  end;

  procedure check_status; { used to read status of nrd 535 }
  var ch:char;
      s1:string;
      dummy:integer;
  begin
    comreadln(COM_NRD,s);
    s:='I'+s;
    with receiverstat do
      begin
        { get attenuator status }
        ch:=s[2];
        case ch of
          '0': attenuator:=NO;
          '1': attenuator:=YES;
          else attenuator:=YES; { error condition }
        end;

        { get bandwidth }
        ch:=s[3];
        case ch of
          '0': bandwidth:=WIDE;
          '1': bandwidth:=INTER;
          '2': bandwidth:=NARR;
          '3': bandwidth:=AUX;
          else bandwidth:=AUX; { error condition }
        end;

        { get receiver mode }
        ch:=s[4];
        case ch of
          '0': mode:=RTTY;
          '1': mode:=CW;
          '2': mode:=USB;
          '3': mode:=LSB;
          '4': mode:=AM;
          '5': mode:=FM;
          '6': mode:=FAX;
          '7': mode:=ECSS_USB;
          '8': mode:=ECSS_LSB;
          else mode:=FM; { error condition }
        end;

        { get frequency }
        s1:=copy(s,5,8);
        val(s1,frequency,dummy);
        frequency:=frequency / 1000.0;

        { get agc setting }
        ch:=s[13];
        case ch of
          '0': agc:=SLOW;
          '1': agc:=FAST;
          '2': agc:=OFF;
          else agc:=OFF; { error condition }
        end;
      end;
  end;

  procedure remote_on;
  { enable remote control of radio, get receiver status }
  const ECHO   = FALSE;
        STRLEN = 40;
  var s,s1:string;
      dummy:integer;
      ch:char;

    procedure initiate_remote; { send remote on string }
    begin
      write_com(COM_NRD,'H1');      { enable receiver remote mode }
    end;

    procedure check_serial_port(var s1:string);

    { This is a bizarre procedure to minimize program hanging in the event
      that the radio is left off or the serial port is selected to another
      device.  It uses an algorithm that assumes that no response to the
      remote command is an indication of error as is receiving a response
      back that does not begin in "C".  The latter can happen if the serial
      port is attached to a modem for example...}

      procedure check_response(ch:char; var s1:string);
      var ch1:char;
      begin
        if ch = 'C' then { all is (assumed) ok }
          begin
            s1:=' '; s1[1]:=ch;
          end
        else
          begin
            writeln(output,
  'Improper response from radio --- check connections and re-run program');
            writeln(output,'Hit any key to continue');
            repeat until keypressed;
            ch1:=readkey;
            halt;
          end;
      end;

    var ch, ch1:char;
    begin
      if com_nrd = 0 then { abort check }
        begin
          s1:='';
          exit;
        end;
      if not async_buffer_check(ch) then { something is wrong }
        begin
          delay(250); { just in case }
          if not async_buffer_check(ch) then { hung for sure }
            begin
              writeln(output,
              'No response from receiver.  Correct and hit any key');
              repeat until keypressed;
              ch1:=readkey;
              s1:='';
              initiate_remote;
            end
          else check_response(ch,s1);
        end
      else check_response(ch,s1);
    end;

  begin
    if com_nrd > 0 then while async_buffer_check(ch) do;
            { nrd sometimes leaves stuff behind }
    initiate_remote;
    if radio_type = 535 then exit
    else
      begin
        check_serial_port(s1); { will return 1st char in s1 }
        with receiverstat do
          begin
            { get channel }
            comreadln(COM_NRD,s);
            s:=s1 + s;
            delete(s,1,1); { remove "C" }
            val(s,channel,dummy);

            { get receiver mode }
            comreadln(COM_NRD,s);
            ch:=s[2];
            case ch of
              '0': mode:=RTTY;
              '1': mode:=CW;
              '2': mode:=USB;
              '3': mode:=LSB;
              '4': mode:=AM;
              '5': mode:=FM;
              '6': mode:=FAX;
              else mode:=FM; { error condition }
            end;

            { get agc setting }
            comreadln(COM_NRD,s);
            ch:=s[2];
            case ch of
              '0': agc:=SLOW;
              '1': agc:=FAST;
              '2': agc:=OFF;
              else agc:=OFF; { error condition }
            end;

            { get attenuator status }
            comreadln(COM_NRD,s);
            ch:=s[2];
            case ch of
              '0': attenuator:=NO;
              '1': attenuator:=YES;
              else attenuator:=YES; { error condition }
            end;

            { get bandwidth }
            comreadln(COM_NRD,s);
            ch:=s[2];
            case ch of
              '0': bandwidth:=WIDE;
              '1': bandwidth:=INTER;
              '2': bandwidth:=NARR;
              '3': bandwidth:=AUX;
              else bandwidth:=AUX; { error condition }
            end;

            { get frequency }
            comreadln(COM_NRD,s);
            delete(s,1,1); { get rid of "F" }
            val(s,frequency,dummy);
            frequency:=frequency / 100.0;
          end;
      end;
  end;

  procedure remote_off;
  begin
    if radio_type = 535 then exit;
    write_com(COM_NRD,'H0'); { disable receiver remote mode }
    delay(dly);
  end;

  procedure toggle_remote; { unlock radio }
  var ch:char;
      s:string;
  begin
    write_com(COM_NRD,'I0');
    write_com(COM_NRD,'I1');
    delay(200);
    if async_buffer_check(ch) then check_status(s);
  end;

  procedure set_freq;
  var s:string;
  begin
    str(frequency:8:2,s);
    while s[1] = ' ' do delete(s,1,1);
    while length(s) < 9 do s:=concat('0',s);
    s:=concat('F',s);
    delete(s,8,1); { remove "." }
    if radio_type = 535 then
      begin
        delete(s,2,1);
        s:=s + '0';
      end;
    write_com(COM_NRD,s);
    if radio_type = 525 then comreadln(COM_NRD,s);
  end;

  procedure set_mode;
  var ch:char;
      s:string;
  begin
    case mode of
      RTTY:     s:='0';
      CW:       s:='1';
      USB:      s:='2';
      LSB:      s:='3';
      AM:       s:='4';
      FM:       s:='5';
      FAX:      s:='6';
      ECSS_USB: s:='7';
      ECSS_LSB: s:='8';
    end;
    s:=concat('D',s);
    write_com(COM_NRD,s);
    if radio_type = 525 then comreadln(COM_NRD,s);
  end;

  procedure set_bandwidth;
  var ch:char;
      s:string;
  begin
    case bandwidth of
      WIDE:  s:='0';
      INTER: s:='1';
      NARR:  s:='2';
      AUX:   s:='3';
    end;
    s:=concat('B',s);
    write_com(COM_NRD,s);
    if radio_type = 525 then comreadln(COM_NRD,s);
  end;

  procedure set_agc;
  var ch:char;
      s:string;
  begin
    case agc of
      SLOW:  s:='0';
      FAST:  s:='1';
      OFF:   s:='2';
    end;
    s:=concat('G',s);
    write_com(COM_NRD,s);
    comreadln(COM_NRD,s);
  end;

  procedure set_attenuator;
  var ch:char;
      s:string;
  begin
    case attenuator of
      NO:  s:='0';
      YES: s:='1';
    end;
    s:=concat('A',s);
    write_com(COM_NRD,s);
    comreadln(COM_NRD,s);
  end;

  procedure set_all; { used to set all parameters for an NRD535 }
  var s,s1:string;
  begin
    s:='S';
    str(channel,s1);
    while length(s1) < 3 do s1:='0' + s1;
    s:=s + s1;
    case attenuator of
      NO: s:=s + '0';
      YES:s:=s + '1';
    end;
    case bandwidth of
      WIDE:  s:=s + '0';
      INTER: s:=s + '1';
      NARR:  s:=s + '2';
      AUX:   s:=s + '3';
    end;
    case mode of
      RTTY:     s:=s + '0';
      CW:       s:=s + '1';
      USB:      s:=s + '2';
      LSB:      s:=s + '3';
      AM:       s:=s + '4';
      FM:       s:=s + '5';
      FAX:      s:=s + '6';
      ECSS_USB: s:=s + '7';
      ECSS_LSB: s:=s + '8';
    end;
    str(frequency:8:2,s1);
    while s1[1] = ' ' do delete(s1,1,1);
    while length(s1) < 8 do s1:=concat('0',s1);
    delete(s1,6,1); { remove "." }
    s:=s + s1 + '00';
    write_com(COM_NRD,s);
  end;

  procedure init; { initialize port address, file path and existence of MAP }
  const CONFIG_PATH = 'CONFIG.DAT';
  var buf:file;
      configdat:configtype;
      num:integer;

    procedure open_config(var rslt:integer);
    var ch:char;
        ok,dummy:boolean;
        hour,minute,sec,sec100:word;
        s:string;
    begin
      assign(buf,CONFIG_PATH);
      repeat
        reset(buf,sizeof(configdat));
        rslt:=ioresult;
        if rslt = FILE_NOT_FOUND then
          begin
            repeat
              home;
              writea(LIGHTGREEN, FOREGROUND);
              writeln(output,
  'System could not find Config.dat file.  Please answer these questions');
              writeln(output,
  'about your system and Config.dat will be created for you...');
              entnum(0,10,num,ok,dummy,
                   'your com port (eg 1 for COM1:, 0 for demo):');
              if num in [0..4] then configdat.com_port:=num;
              if not ok then halt;
            until num in [0..4];
            writeln(output);
            writea(LIGHTGREEN, FOREGROUND);
            repeat
              write(output,'Enter receiver type (525 or 535):');
              readln(input,s);
            until (s = '525') or (s = '535');
            if s = '525' then configdat.receiver_type:=525
                         else configdat.receiver_type:=535;
            if configdat.receiver_type = 525 then
              begin
                write(output,'Do you have a KIWA MAP unit? (y=yes):');
                read(input,ch);
                configdat.has_map:=ch in ['y','Y'];
                writeln(output);
              end
            else configdat.has_map:=FALSE;
            writeln(output,
'Now we will adjust the time offset so time is referenced to GMT.');
            writeln(output,
'Enter the hour only (not minutes) in GMT (eg if GMT = 16:47, enter 16.');
            entnum(0,17,num,ok,dummy,'the');
            if not ok then halt;
            gettime(hour,minute,sec,sec100);
            configdat.time_offset:=num - hour;
            rewrite(buf,sizeof(configdat));
            blockwrite(buf,configdat,1);
            close(buf);
            reset(buf,sizeof(configdat));
            rslt:=ioresult;
          end;
        hndlerr(FALSE,ch,rslt);
      until (rslt = 0) or (ch = KEYINFO.ESCKEY);
    end;

    procedure get_config;
    var ch:char;
        rslt:integer;
    begin
      open_config(rslt);
      if rslt = 0 then
        begin
          blockread(buf,configdat,1);
          rslt:=ioresult;
          hndlerr(FALSE,ch,rslt);
        end;
      com_nrd:=configdat.com_port;
      has_map:=configdat.has_map;
      radio_type:=configdat.receiver_type;
      gmt_offset:=configdat.time_offset;
      close(buf);
    end;

  begin
    get_config;
  end;

begin
  init
end.